home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
The Best of MacTutor - S…e Code for Volumes 1 to 5
/
The Best of MacTutor - Source Code for Volume 1-5 (Wayzata Technology)(6031)(1990).bin
/
Source Code
/
#50 (Nov 89)
/
SC#50.sit
/
Source Code Dispatcher
/
dispatcher.p
< prev
next >
Wrap
Text File
|
1989-07-13
|
31KB
|
875 lines
{
File: dispatcher.p
Program: dispatcher
Author: Roger A. Horton
Verity Software Systems
Copyright 1989, All Rights Reserved
Creation: 6/4/89
Purpose: Create a small utility program to launch applications
from the Finder with associated launch documents. This
is especially useful for custom applications that require
a number of files, and that may cause a user confusion in
installing and launching the application.
Technique: This program performs a launch (not a sublaunch) using the
code of Mac Tech Note #126 as a model. The utility does not
directly initiate the launch, but relies on associated
data documents to initiate the process, and to determine
which application and documents are to be launched. The
launch utility and document(s) can be located anywhere in
the file system. By double clicking on a launch document,
the user causes the Finder to locate and launch the launch
utility program. The utility then reads the launch data
document to obtain the name and location of the application
and its associated document. The Finder application parameters
are then set up, and the application is launched. If the
location of the application or its associated documents has
changed since the last launch, the user is prompted to find
their new location. In essence, the launch utility documents
act as aliases for target applications, and add additional
usefulness by providing for automatic control of associated
application documents.
Program History:
}
program scan;
{$D+} { Macsbug/TMON symbols }
{$R-} { Turn off range checking }
uses
{ Macintosh toolbox units }
PasLibIntf,Memtypes,QuickDraw,OSIntf,ToolIntf,PackIntf,
SANE, PrintTraps, ROMDefs
{ Custom units }
const
active = 0; { for use in controls and menus }
inactive = 255;
DfltDlogID = 200; { resource ID for configuration dialog }
StopDlogID = 201; { resource ID for stop alert dialog }
AppParmGVar = $AEC; { AppParmHandle system global variable }
type
{ general types }
pLaunchStruct = ^LaunchStruct; { Launch record }
LaunchStruct = record
pfName: ^Str255; { pointer to application name }
param: integer; { alternate video,audio buffers }
LC: packed array[0..1] of char; { extended parameters }
extBlockLen: longint; { extra block length }
fFlags: integer; { finder file info flags }
launchFlags: longint; { bits 30,31 = 1 for sublaunch }
end;
FileLInfo = record { Finder files }
vRefNum: integer; { 2 bytes }
fType: OSType; { file type - 4 bytes }
version: boolean; { 1 byte }
unused: boolean; { 1 byte }
fName: Str255; { 1 length byte, variable length string }
end;
APHdl = ^APPtr; { Finder info }
APPtr = ^APRec;
APRec = record
message: integer; { 2 bytes }
count: integer; { 2 bytes }
files: array[1..1] of FileLInfo;
end;
LaunchData = record { application & document data settings }
vName: Str255; { volume name }
vRefNum: integer; { working directory reference # }
dirID: longint; { directory ID # }
fName: Str255; { file name }
fType: OSType; { file type }
useIt: integer; { whether to open associated document }
end;
var
{ file system parameter blocks }
myPB: ParamBlockRec;
myHPB: HParamBlockRec;
myInfoPB: CInfoPBRec;
myWDPB: WDPBRec;
{ launch data records }
appLData: LaunchData; { application }
docLData: LaunchData; { document }
{ miscellaneous }
done: integer; { done flag }
lcnt: integer; { loop counter }
{ ****** Utility functions and procedures ****** }
procedure AlertMsg(msgStr1, msgStr2:Str255);
{ Procedure to print alert message.
To print numerics, use something like this:
testStr1, testStr2: Str255;
NumToString(reqCnt, testStr1);
NumToString(reqCnt, testStr2);
AlertMsg(testStr1, testStr2); }
var
theRect:rect;
ignore:integer;
begin
ParamText(msgStr1, msgStr2, '', '');
ignore := StopAlert(StopDlogID,NIL);
end; { procedure AlertMsg }
{ ********* Error Handling *********** }
function GetErrorMsg(result:OSErr):string;
begin
result := abs(result);
case result of
18: GetErrorMsg := 'driver error during status operation';
19: GetErrorMsg := 'driver error during read operation';
20: GetErrorMsg := 'driver error during write operation';
27: GetErrorMsg := 'driver I/O error caused abort of operation';
28: GetErrorMsg := 'driver not open';
33: GetErrorMsg := 'the file directory is full';
34: GetErrorMsg := 'all allocation blocks on the volume are full';
35: GetErrorMsg := 'the specified volume is not mounted';
36: GetErrorMsg := 'there was an unspecified I/O error';
37: GetErrorMsg := 'the file or volume name is bad';
39: GetErrorMsg := 'logical EOF reached unexpectedly';
40: GetErrorMsg := 'attempt made to position before start of file';
42: GetErrorMsg := 'too many files are open';
43: GetErrorMsg := 'the file could not be found';
44: GetErrorMsg := 'the volume is locked by hardware setting';
45: GetErrorMsg := 'the file is locked';
46: GetErrorMsg := 'the volume is locked by a software flag';
47: GetErrorMsg := 'the file is already in use';
48: GetErrorMsg := 'a file with specified name exists';
49: GetErrorMsg := 'the file is already open for read/write';
50: GetErrorMsg := 'no volume specified and no default volume';
51: GetErrorMsg := 'a non-existent path was specified';
52: GetErrorMsg := 'the was an error finding current position in file';
53: GetErrorMsg := 'the specified volume is not on-line';
54: GetErrorMsg := 'attempt to open a locked file for writing';
55: GetErrorMsg := 'attempt to mount an already mounted volume';
56: GetErrorMsg := 'the specified drive number is not mounted';
57: GetErrorMsg := 'the volume lacks a Macintosh format directory';
58: GetErrorMsg := 'there was an external file system error';
59: GetErrorMsg := 'there was a problem during renaming';
60: GetErrorMsg := 'the master directory block is bad';
61: GetErrorMsg := 'read/write permission does not allow writing';
108: GetErrorMsg := 'there is insufficient application memory';
109: GetErrorMsg := 'a nil master pointer has been encountered';
111: GetErrorMsg := 'attempt to operate on a free block';
112: GetErrorMsg := 'attempt to purge a locked block';
117: GetErrorMsg := 'the block is locked';
120: GetErrorMsg := 'the directory could not be found';
121: GetErrorMsg := 'too many working directories are open';
122: GetErrorMsg := 'a folder cannot be placed in its own subfolder';
123: GetErrorMsg := 'attempt HFS operations on non-HFS volume';
127: GetErrorMsg := 'there was an internal file system error';
128: GetErrorMsg := 'printing aborted at user request';
end;
end; { function GetErrorMsg }
procedure IOCheck(result:OSErr);
var
ignore:integer;
errorString:Str255;
begin
if result <> NoErr then
begin
NumToString(result,errorString);
ParamText('Macintosh OS Error #:',
errorString,
'Macintosh OS Error Desc:',
GetErrorMsg(result));
ignore := StopAlert(StopDlogID,NIL);
end
end; { procedure IOCheck }
procedure LaunchFailed(errNo:OSErr);
var
ignore:integer;
errorString:Str255;
begin
NumToString(errNo,errorString);
ParamText('Launch Error #:',
errorString,
'','');
ignore := StopAlert(StopDlogID,NIL);
end; { procedure LaunchFailed }
procedure NotFoundMsg(str1,str2:Str255);
var
ignore: integer;
begin
ParamText('Please help locate',
str1, str2,
'using the following dialog...');
ignore := StopAlert(StopDlogID,NIL);
end; { procedure LaunchFailed }
{ ********* Configuration routines *********** }
function ReadDefaultData: integer;
{ Open the launch data file and read the data necessary for
locating launch application and associated document (if any). }
var
theErr: OSErr;
myAppFile: AppFile;
myRefNum: integer;
theResult: integer;
appMsg: integer;
appCount: integer;
begin
theResult := 0; { be optimistic }
CountAppFiles(appMsg, appCount);
if appCount < 1 then
begin
theResult := 1;
AlertMsg('Dispatcher must be launched','from a data document');
{ could create a new data document file instead }
end
else
begin
GetAppFiles(1, myAppFile);
{ open the file for reading }
myPB.ioCompletion := nil;
myPB.ioNamePtr := @myAppFile.fName;
myPB.ioVRefNum := myAppFile.vRefNum;
myPB.ioPermssn := fsRdWrPerm; { read/write permission }
myPB.ioMisc := nil; { use volume buffer }
theErr := PBOpen(@myPB, false);
if theErr <> noErr then
begin
IOCheck(theErr);
theResult := 1;
end
else
begin
myRefNum := myPB.ioRefNum;
{ read the application launch data }
myPB.ioCompletion := nil;
myPB.ioRefNum := myRefNum;
myPB.ioBuffer := @appLData;
myPB.ioReqCount := sizeof(LaunchData);
myPB.ioPosMode := fsAtMark;
myPB.ioPosOffset := 0;
theErr:= PBRead(@myPB, false);
if ((theErr <> noErr) or (myPB.ioActCount < 1)) then
begin
appLData.vName := 'Uninitialized';
appLData.dirID := 0;
appLData.fName := 'Uninitialized';
appLData.fType := 'APPL';
appLData.useIt := 1; { not used }
end;
{ read the document launch data }
myPB.ioCompletion := nil;
myPB.ioRefNum := myRefNum;
myPB.ioBuffer := @docLData;
myPB.ioReqCount := sizeof(LaunchData);
myPB.ioPosMode := fsAtMark;
myPB.ioPosOffset := 0;
theErr:= PBRead(@myPB, false);
if ((theErr <> noErr) or (myPB.ioActCount < 1)) then
begin
docLData.vName := 'Uninitialized';
docLData.dirID := 0;
docLData.fName := 'Uninitialized';
docLData.fType := 'TEXT';
docLData.useIt := 1;
end;
{ close the data file }
myPB.ioCompletion := nil;
myPB.ioRefNum := myRefNum;
theErr:= PBClose(@myPB, false);
end; { if data file opened OK }
end; { if app files count is > 0 }
ReadDefaultData := theResult;
end; { procedure ReadDefaultData }
function WriteDefaultData: integer;
{ Open the launch data file and write the data necessary for
locating launch application and associated document (if any).
This should take place any time the data is changed. }
var
theErr: OSErr;
myAppFile: AppFile;
myRefNum: integer;
theResult: integer;
begin
theResult := 0; { be optimistic }
GetAppFiles(1, myAppFile);
{ open the file for reading/writing }
myPB.ioCompletion := nil;
myPB.ioNamePtr := @myAppFile.fName;
myPB.ioVRefNum := myAppFile.vRefNum;
myPB.ioPermssn := fsRdWrPerm; { read/write permission }
myPB.ioMisc := nil; { use volume buffer }
theErr:= PBOpen(@myPB, false);
if theErr <> noErr then
begin
IOCheck(theErr);
theResult := 1;
end
else
begin
myRefNum := myPB.ioRefNum;
{ write the application launch data }
myPB.ioCompletion := nil;
myPB.ioRefNum := myRefNum;
myPB.ioBuffer := @appLData;
myPB.ioReqCount := sizeof(LaunchData);
myPB.ioPosMode := fsAtMark;
myPB.ioPosOffset := 0;
theErr:= PBWrite(@myPB, false);
if ((theErr <> noErr) or (myPB.ioActCount < 1)) then
begin
IOCheck(theErr);
theResult := 1;
end
else
begin
{ write the document launch data }
myPB.ioCompletion := nil;
myPB.ioRefNum := myRefNum;
myPB.ioBuffer := @docLData;
myPB.ioReqCount := sizeof(LaunchData);
myPB.ioPosMode := fsAtMark;
myPB.ioPosOffset := 0;
theErr:= PBWrite(@myPB, false);
if ((theErr <> noErr) or (myPB.ioActCount < 1)) then
begin
IOCheck(theErr);
theResult := 1;
end; { if bad document write }
end; { if application write OK }
{ close the data file }
myPB.ioCompletion := nil;
myPB.ioRefNum := myRefNum;
theErr:= PBClose(@myPB, false);
end; { if data file opened OK }
WriteDefaultData := theResult;
end; { procedure WriteDefaultData }
function FindApplFile: integer;
{ Given the info in the data document, try to find the target
application's working directory reference number. If it can't
be found, then prompt the user to find it. }
var
theErr: OSErr;
theResult: integer;
reply: SFReply;
topLeft: Point;
fileFilter: SFTypeList;
appdone, appfound: integer;
theName: Str255;
theIndex: integer;
theRefNum: integer;
begin
theResult := 0; { be optimistic }
{ see if the volume is mounted }
theIndex := 1;
appdone := 0; appfound := 0; theName:= '';
repeat
myHPB.ioVolIndex := theIndex;
myHPB.ioCompletion := NIL;
myHPB.ioNamePtr := @theName;
theErr := PBHGetVInfo(@myHPB, false);
if theErr <> noErr then
appdone := 1; { no more volumes to check }
if theName = appLData.vName then
begin
appfound := 1; appdone := 1;
theRefNum := myHPB.ioVRefNum;
end;
theIndex := theIndex + 1;
until appdone > 0;
if appfound = 0 then
theResult := 1
else
begin
{ see if file can be found }
myHPB.ioCompletion := NIL;
myHPB.ioNamePtr := @appLData.fName;
myHPB.ioVRefNum := theRefNum; { from call above }
myHPB.ioFDirIndex := 0; { use file name, not index }
myHPB.ioDirID := appLData.dirID; { use stored Dir ID }
theErr := PBHGetFInfo(@myHPB,false);
if (theErr <> noErr) then
begin
{ IOCheck(theErr); }
theResult := 1;
end
else
begin
{ get the current application WD Ref Num }
myWDPB.ioCompletion := nil;
myWDPB.ioNamePtr := nil; { directory name }
myWDPB.ioVRefNum := theRefNum;
myWDPB.ioWDProcID := longint('ERIK');
myWDPB.ioWDDirID := appLData.dirID;
theErr := PBOpenWD(@myWDPB, false);
appLData.vRefNum := myWDPB.ioVRefNum;
IOCheck(theErr);
end; { getting the current WD Ref Num }
end; { if volume was found OK }
{ if application couldn't be found using default information,
make the user find it manually. }
if theResult <> 0 then
begin
NotFoundMsg('the program file: ',appLData.fName);
topLeft.h := 80; topLeft.v := 70;
fileFilter[0] := appLData.fType;
SFGetFile(topLeft,'',NIL,1,fileFilter,NIL,reply);
if reply.Good then
begin
theResult := 0; { reset the error flag }
appLData.vRefNum := reply.vRefNum; { WD RefNum }
appLData.fName := reply.fName;
appLData.fType := reply.fType;
{ look up new volume name }
myHPB.ioCompletion := NIL;
myHPB.ioNamePtr := @appLData.vName;
myHPB.ioVRefNum := appLData.vRefNum;
myHPB.ioVolIndex := 0; { use vRefNum, not name }
theErr := PBHGetVInfo(@myHPB,false);
IOCheck(theErr);
{ look up new application directory ID }
myInfoPB.ioCompletion := nil;
myInfoPB.ioNamePtr:= @appLData.fName;
myInfoPB.ioVRefNum := appLData.vRefNum;
myInfoPB.ioFDirIndex := 0;
myInfoPB.ioDirID := 0;
theErr := PBGetCatInfo(@myInfoPB,false);
IOCheck(theErr);
appLData.dirID := myInfoPB.ioFLParID;
{ update the default data }
if WriteDefaultData <> 0 then
theResult := 1;
end { if reply is good }
else
begin
theResult := 1;
end; { user cancelled application lookup }
end; { if default application location not valid }
FindApplFile := theResult;
end; { procedure FindApplFile }
function FindDocFile: integer;
{ Given the info in the data document, try to find the launch
document's working directory reference number. If it can't
be found, then prompt the user to find it. }
var
theErr: OSErr;
theResult: integer;
reply: SFReply;
topLeft: Point;
fileFilter: SFTypeList;
docdone, docfound: integer;
theName: Str255;
theIndex: integer;
theRefNum: integer;
begin
theResult := 0; { be optimistic }
{ see if there is an associated document with the application }
if (docLData.useIt = 1) then { launch with associated document }
begin
{ see if the volume is mounted }
theIndex := 1;
docdone := 0; docfound := 0; theName:= '';
repeat
myHPB.ioVolIndex := theIndex;
myHPB.ioCompletion := NIL;
myHPB.ioNamePtr := @theName;
theErr := PBHGetVInfo(@myHPB, false);
if theErr <> noErr then
docdone := 1; { no more volumes to check }
if theName = docLData.vName then
begin
docfound := 1; docdone := 1;
theRefNum := myHPB.ioVRefNum;
end;
theIndex := theIndex + 1;
until docdone > 0;
if docfound = 0 then
theResult := 1
else
begin
{ see if the file can be found in its directory }
myHPB.ioCompletion := NIL;
myHPB.ioNamePtr := @docLData.fName;
myHPB.ioVRefNum := theRefNum; { from call above }
myHPB.ioFDirIndex := 0; { use file name, not index }
myHPB.ioDirID := docLData.dirID; { use stored Dir ID }
theErr := PBHGetFInfo(@myHPB,false);
if (theErr <> noErr) then
begin
{ IOCheck(theErr); }
theResult := 1;
end
else
begin
{ get the current document WD Ref Num }
myWDPB.ioCompletion := nil;
myWDPB.ioNamePtr := nil; { directory name }
myWDPB.ioVRefNum := theRefNum;
myWDPB.ioWDProcID := longint('ERIK');
myWDPB.ioWDDirID := docLData.dirID;
theErr := PBOpenWD(@myWDPB, false);
docLData.vRefNum := myWDPB.ioVRefNum;
IOCheck(theErr);
end; { getting the current WD Ref Num }
end; { if volume was found OK }
{ if document couldn't be found using default information,
make the user find it manually. }
if theResult <> 0 then
begin
NotFoundMsg('the associated document: ',docLData.fName);
topLeft.h := 80; topLeft.v := 70;
fileFilter[0] := docLData.fType;
SFGetFile(topLeft,'',NIL,-1,fileFilter,NIL,reply);
if reply.Good then
begin
theResult := 0; { reset the error flag }
docLData.vRefNum := reply.vRefNum;
docLData.fName := reply.fName;
docLData.fType := reply.fType;
{ look up new volume name }
myHPB.ioCompletion := nil;
docLData.vName := '';
myHPB.ioNamePtr := @docLData.vName;
myHPB.ioVRefNum := docLData.vRefNum;
myHPB.ioVolIndex := 0; { use vRefNum, not name }
theErr := PBHGetVInfo(@myHPB,false);
{ look up new document parent directory ID }
myInfoPB.ioCompletion := nil;
myInfoPB.ioNamePtr:= @docLData.fName;
myInfoPB.ioVRefNum := docLData.vRefNum;
myInfoPB.ioFDirIndex := 0;
myInfoPB.ioDirID := 0;
theErr := PBGetCatInfo(@myInfoPB,false);
IOCheck(theErr);
docLData.dirID := myInfoPB.ioFLParID; { parent directory ID }
{ update the default data }
if WriteDefaultData <> 0 then
theResult := 1;
end { if reply is good }
else
begin
theResult := 1;
end; { user cancelled document lookup }
end; { if default document location not valid }
end; { if associated document exists }
FindDocFile := theResult;
end; { procedure FindDocFile }
function EditDefaults: integer;
var
itemHit: integer;
itemType: integer;
itemRect: Rect;
dfltDlg: DialogPtr;
itemHdl1, itemHdl2: Handle; { edittext handles }
itemHdl3: Handle; { check box dialog handle }
cBoxHdl1: ControlHandle; { check box control handle }
theResult: integer;
begin
theResult := 0;
{ get dialog & edittext handles }
dfltDlg := GetNewDialog(DfltDlogID, nil, Pointer(-1));
GetDItem(dfltDlg, 4, itemType, itemHdl1, itemRect);
GetDItem(dfltDlg, 5, itemType, itemHdl2, itemRect);
GetDItem(dfltDlg, 6, itemType, itemHdl3, itemRect);
cBoxHdl1 := ControlHandle(itemHdl3);
SetIText(itemHdl1, appLData.fName); { app filename }
SetIText(itemHdl2, docLData.fName); { doc filename }
SetCtlValue(cBoxHdl1, docLData.useIt); { use/don't use document }
{ put up dialog }
itemHit := 0;
while ((itemHit > 3) or (itemHit < 1)) do
begin
ModalDialog(nil, itemHit);
if itemHit = 6 then { toggle the check box }
begin
if (GetCtlValue(cBoxHdl1) = 0) then
SetCtlValue(cBoxHdl1, 1)
else
SetCtlValue(cBoxHdl1, 0);
end;
end; { while }
{ get dialog results }
case itemHit of
1: begin { use names entered in dialog }
{ application name }
GetIText(itemHdl1, appLData.fName);
{ document name }
GetIText(itemHdl2, docLData.fName);
end;
2: begin { cause a search for new files }
appLData.fName := 'XXXXXXXX';
docLData.fName := 'XXXXXXXX';
end;
3: theResult := 1; { cancel the launch }
end;
if (theResult = 0) then
begin
docLData.useIt := GetCtlValue(cBoxHdl1);
theResult := WriteDefaultData; { update the defaults }
end;
DisposDialog(dfltDlg);
EditDefaults := theResult;
end; { EditDefaults }
function TestCommandKey: integer;
{ if command is held down while starting, the user will
be allowed to edit the default settings. The file data
has already been read at this point. If the user cancels,
the data defaults are not changed. }
var
theResult: integer;
eventReady: boolean;
myEvent: EventRecord;
begin
theResult := 0;
eventReady := GetNextEvent(everyEvent, myEvent);
if (BAND(myEvent.modifiers,cmdkey) > 0) then
theResult := EditDefaults;
TestCommandKey := theResult;
end; { TestCommandKey }
{ ********* Transfer and launch routines *********** }
function ResetFinderInfo: integer;
{ This is an example of how the finder parms could be changed
without allocating a new structure in the system heap. However,
the changes could not exceed the size of the existing heap object.
This routine is not used. }
var
fInfoHdl: Handle;
hSize: integer;
appParmRec: APRec; { my Finder info }
theResult: integer;
begin
theResult := 0; { be optimistic }
{ get AppParmHandle, lock it, and copy parms record }
fInfoHdl := Handle(AppParmGVar);
fInfoHdl := Handle(fInfoHdl^);
HLock(fInfoHdl);
hSize := GetHandleSize(fInfoHdl);
BlockMove(Pointer(fInfoHdl^), Pointer(@appParmRec), hSize);
if (appParmRec.count > 0) then
begin
if (length(appParmRec.files[1].fName) >= length(docLData.fName)) then
begin
{ now change the launch parameters }
appParmRec.files[1].fName := docLData.fName;
appParmRec.files[1].fType := docLData.fType;
appParmRec.files[1].vRefNum := docLData.vRefNum;
BlockMove(Pointer(@appParmRec), Pointer(fInfoHdl^), hSize);
end
end
else
begin
AlertMsg('Unable to reset', 'launch file parameters');
theResult := 1;
end;
HUnlock(fInfoHdl);
ResetFinderInfo := theResult;
end; { ResetFinderInfo }
function ZeroFinderInfo: integer;
{ If no associated documents are needed, then the number of
files in the app parm handle block must be set to zero, and
the file types set to zero so the Finder can clean up when
it gets control back. The number of files will always be 1
when this routine is called. }
var
fInfoHdl: Handle; { Finder info handle }
hSize: integer;
appParmRec: APRec; { my Finder info }
theResult: integer;
begin
theResult:= 0; { be optimistic }
{ get handle, lock it, and copy parms record }
fInfoHdl := Handle(AppParmGVar);
fInfoHdl := Handle(fInfoHdl^);
HLock(fInfoHdl);
hSize := GetHandleSize(fInfoHdl);
BlockMove(Pointer(fInfoHdl^), Pointer(@appParmRec), hSize);
if (appParmRec.count > 0) then
begin
{ now change the launch parameters }
appParmRec.count := 0;
appParmRec.files[1].fType := OSType(longint(0));
{ write it back out }
BlockMove(Pointer(@appParmRec), Pointer(fInfoHdl^), hSize);
end;
HUnlock(fInfoHdl);
ZeroFinderInfo := theResult;
end; { ZeroFinderInfo }
function ReplaceFinderInfo: integer;
{ To prepare for the launch, the finder launch information must
be reset to hold the name and type of the database startup file.
This routine disposes the old AppParmHandle heap object and allocates
a new one on the system heap. Returns 0 if successful, 1 if an error
occurred. }
var
fInfoHdl: Handle; { handle to Finder info }
sysZone: THz; { system heap zone pointer }
appZone: THz; { application heap zone pointer }
hSize: integer;
appParmRec: APRec; { my Finder info }
theErr: OSErr;
theResult: integer;
saveAppParm: ^longint; { pointer used to access $AEC }
begin
theResult := 0; { be optimistic }
{ get handle, lock it, and copy parms record }
fInfoHdl := Handle(appParmGVar);
fInfoHdl := Handle(fInfoHdl^);
HLock(fInfoHdl);
hSize := GetHandleSize(fInfoHdl);
BlockMove(Pointer(fInfoHdl^), Pointer(@appParmRec), hSize);
{ dispose the old handle in the system zone}
HUnlock(fInfoHdl);
appZone := GetZone;
sysZone := SystemZone;
SetZone(sysZone);
DisposHandle(fInfoHdl);
{ allocate a new handle in the system zone }
hSize := 13 + length(docLData.fName); { enough for one document }
fInfoHdl := NewHandle(hSize);
theErr := MemError;
SetZone(appZone);
if theErr <> noErr then
begin
IOCheck(theErr);
theResult := 1;
end
else
begin
HLock(fInfoHdl);
{ put the new handle back at $AEC }
saveAppParm := Pointer(AppParmGVar);
saveAppParm^ := longint(fInfoHdl);
{ now change the launch parameters }
appParmRec.message:= 0; { open it }
appParmRec.count:= 1; { number of documents }
appParmRec.files[1].vRefNum := docLData.vRefNum;
appParmRec.files[1].fType := docLData.fType;
appParmRec.files[1].version := false;
appParmRec.files[1].unused := false;
appParmRec.files[1].fName := docLData.fName;
BlockMove(Pointer(@appParmRec), Pointer(fInfoHdl^), hSize);
HUnlock(fInfoHdl);
end; { if sys heap handle allocated OK }
ReplaceFinderInfo := theResult;
end; { ReplaceFinderInfo }
function LaunchIt(pLnch: pLaunchStruct): OSErr;
{ from tech note #52 & 126 }
INLINE $205F, $A9F2, $3E80;
procedure DoLaunch;
{ Launch the application, given the information in the
launch data records for the application & document. }
var
fileInfo: FInfo;
ignore: integer;
myLaunch: LaunchStruct;
theErr: OSErr;
begin
{ set the default working directory to the application's folder }
myWDPB.ioCompletion := NIL;
myWDPB.ioNamePtr := NIL;
myWDPB.ioVRefNum := appLData.vRefNum;
theErr := PBSetVol(@myWDPB,false);
{ get finder flags for launch record}
myInfoPB.ioNamePtr:= @appLData.fName;
myInfoPB.ioVRefNum := appLData.vRefNum;
myInfoPB.ioFDirIndex := 0; { use the name instead of index }
myInfoPB.ioDirID := 0;
theErr := PBGetCatInfo(@myInfoPB,false);
{ now launch the application }
myLaunch.pfName := @appLData.fName;
myLaunch.param := 0;
myLaunch.LC := 'LC';
myLaunch.extBlockLen := 6;
myLaunch.LaunchFlags:= $00000000; { $C0000000 for sublaunch }
myLaunch.fFlags := myInfoPB.ioFlFndrInfo.fdFlags; { from GetCatInfo }
theErr := LaunchIt(@myLaunch);
if theErr < 0 then
LaunchFailed(theErr);
end; { procedure DoLaunch }
function PrepareForLaunch: integer;
{ set up the AppParmsHandle data }
var
theResult: integer;
begin
theResult := 0;
if (docLData.useIt = 1) then { application & document }
theResult := ReplaceFinderInfo
else { application only }
theResult := ZeroFinderInfo;
PrepareForLaunch := theResult;
end; { function PrepareForLaunch }
procedure Initialize;
{ initialize managers & globals }
begin
{ initialize the managers }
InitGraf(@thePort);
InitFonts;
InitWindows;
InitMenus;
TEInit;
InitDialogs(NIL);
FlushEvents(everyEvent,0);
end; { Initialize }
{ main program }
begin
Initialize;
lcnt := 1; done := 0;
while done = 0 do
begin
case lcnt of
1: done := ReadDefaultData;
2: done := TestCommandKey;
3: done := FindApplFile;
4: done := FindDocFile;
5: done := PrepareForLaunch;
6: DoLaunch; { returns only if sublaunched }
end;
lcnt := lcnt + 1;
if lcnt > 6 then done := 1;
end; { while }
end. { dispatcher }